home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / ubas830.zip / MALM.EXE / TTDVD.UB < prev    next >
Text File  |  1990-08-22  |  3KB  |  71 lines
  1.    10   ' Driver program for Tdvd and more
  2.    20   '10 May 1990
  3.    60   dim P(100),M(100)
  4.    65   print:print "*******":print
  5.    70   print "Number, please : ":input N
  6.    75   print N
  7.    80   gosub *Tdvd(N,&P(),&M(),&K,&B)
  8.   100   print "Length is ";K:print "Remaining factor: ";B
  9.   110   print "****** Prime *******"," ***** Multiplicity *****"
  10.   120   for I=1 to K:print P(I),M(I):next I
  11.   130   if B<>1 then print "Not completely factored":end endif
  12.   140   gosub *Tau(&M(),K,&Ans)
  13.   150   print "Number of divisors is ";Ans
  14.   160   gosub *Sigma(&P(),&M(),K,&Ans)
  15.   170   print "Sum of divisors is ";Ans
  16.   180   gosub *Lambda(&P(),&M(),K,&Ans)
  17.   190   print "Carmichael: ";Ans
  18.   195   print:print "*********":print
  19.   200   end
  20.  1200   *Tau(&M(),K,&Ta)
  21.  1210   ' Modeled on the Pascal version. M() is an input parameter.
  22.  1220   ' 8 May 1990
  23.  1230   local I
  24.  1240   Ta=1
  25.  1250   for I=1 to K:Ta=Ta*(M(I)+1):next I
  26.  1260   return ' End of subroutine Tau.
  27.  2260   *Sigma(&P(),&M(),K,&Sig)
  28.  2270   ' Modeled on the Pascal version. P() and M() are input parameters.
  29.  2280   ' 8 May 1990
  30.  2290   local I,J,Tt,Te
  31.  2300   Sig=1
  32.  2310   for J=1 to K:Tt=1:Te=1
  33.  2320   for I=1 to M(J):Tt*=P(J):Te+=Tt:next I
  34.  2330   Sig*=Te
  35.  2340   next J:return ' End of subroutine Sigma.
  36.  4440   *Lambda(&P(),&M(),K,&Lam)
  37.  4450   ' P() and M() are input parameters. This computes the smallest
  38.  4460   ' universal exponent.  Modeled on the Pascal version.
  39.  4470   ' 10 May 1990
  40.  4480   local I,J,Ii,T,Te
  41.  4490   if K=0 then Lam=0:return endif
  42.  4500   Ii=1:Lam=1
  43.  4510   if P(1)=2 then
  44.  4520   :if M(1)=2 then Lam=2 else for I=1 to M(1)-2:Lam=2*Lam next I endif
  45.  4530   :Ii=2 endif
  46.  4540   for J=Ii to K
  47.  4550   Te=1:T=P(J)
  48.  4560   for I=1 to M(J)-1:Te*=T next I
  49.  4570   T=T-1:Te*=T:T=Lam*Te
  50.  4580   Te=gcd(Lam,Te):Lam=T\Te
  51.  4590   next J:return ' End of subroutine Lambda.
  52.  6990   *Tdvd(A,&P(),&M(),&K,&B)
  53.  7000   ' Modeled on the Pascal version
  54.  7010   ' Note that all prime factors found by Tdvd will be less
  55.  7020   ' than 2^34 = 1 71798 69184.
  56.  7030   ' 9 May 1990
  57.  7040   local Ub%=12251,Ubb=17179869184
  58.  7050   local Sga%,Count%=0,I%=0,Z,Q
  59.  7060   K=0:if A=0 then B=0:return endif
  60.  7070   if A>0 then Sga%=1 else Sga%=-1 endif
  61.  7080   A=abs(A):Z=2
  62.  7090   while and{I%<Ub%,Z*Z<=A}
  63.  7100   inc I%:Z=prm(I%)
  64.  7110   repeat Q=A\Z:if res=0 then inc Count%:A=Q endif until res
  65.  7120   if Count%>0 then inc K:P(K)=Z:M(K)=Count%:Count%=0 endif
  66.  7130   wend
  67.  7140   if A<Ubb then B=Sga%
  68.  7150   :if A<>1 then inc K:P(K)=A:M(K)=1 endif
  69.  7160   :else B=A*Sga% endif
  70.  7170   return ' End of subroutine Tdvd.
  71.